perm filename SCISS.SAI[S,AIL]3 blob
sn#076440 filedate 1973-12-07 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00008 PAGES VERSION 3-3(10)
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 HISTORY
00004 00003 BEGIN "SCISS"
00006 00004 PROCEDURE LIBHED COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL
00009 00005 PROCEDURE LIBMAK (STRING F)
00016 00006 MAIN EXECUTION STARTS HERE
00024 00007 IF RPGSW THEN BEGIN "SECOND PASS -- PROCESS LIBRARY"
00027 00008
00031 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,SAIL,REASON
025 300300000012 ⊗;
COMMENT ⊗
VERSION 3-3(10) 12-4-73 BY RHT ADD LIBHED KLUGE TO SCISS
VERSION 3-3(9) 12-4-73
VERSION 3-3(8) 7-13-73 BY JRL AVOID "RENAME DIFFICULTY" FOR SAIREM
VERSION 3-3(7) 7-4-72 BY DCS FIX "D" BUG WHEN SELECTING FROM PROMPT
VERSION 3-3(6) 6-25-72 BY DCS ADD NAM COMMAND TO ORDER, LIBNAM FEATURE TO SCISS
VERSION 3-3(5) 5-23-72 BY DCS AVOID HDRFIL IF NOT NEEDED
VERSION 3-3(4) 2-24-72 BY DCS ADD RENSW CONTROL, CHANGE PARAMETER INPUT
VERSION 3-3(3) 2-10-72 BY DCS ADD OVERRIDE CAPABILITY FOR INTERMEDIATE FILE CREATION
VERSION 3-3(2) 2-10-72 BY DCS UPGRADE ORDER BUSINESS
VERSION 3-3(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
BEGIN "SCISS"
DEFINE VERSION_NUMBER = "'300300000012";
DEFINE
BINI="4",BINO="5",COMO="6",CRLF="('15&'12)",
WILLDO="'1",HAVDON="'2",ERROR="'4",
TTY="1",DSKI="2",DSKO="3",
BIT (X,Y)="Y LAND X",PUTBIT (X,Y)="X←X LOR Y",
REMBIT(X,Y)="X←X XOR Y",
TYPE="OUTSTR(",EOM="&('15&'12))",
WRITE="OUT(DSKO,",READ="INPUT(DSKI,1)",
CONTROLC="'3",STANSW="TRUE",
TOCRLF="8", OVERDEL="9", COMDEL="11"
;
REQUIRE VERSION_NUMBER VERSION;
STRING STR,LINE,LINE1,COMNAM,TS,FILE,FFFF,GOGFIL,RLSTR;
STRING LIBNAM, HLBNAM;
INTEGER I,J,TTYCHAR,FILCNT,SWITCH,W,BREAK,EOF,LOW,HIGH,BEOF,ENTSEEN;
INTEGER SYMBOL,SYMBOLS,RELOC,CCOUT,SYMCNT,TYPP,COMNO,SEEN;
INTEGER DELETING, COMMNT, DSCRING, WILLTELL, EACHASK, MAXTHS;
INTEGER NOTINCOM,DELIM,TEMPP,DOLIB,DOFAIL,CT,YV,DOEXTR;
INTEGER ENTPNT,DOHEAD,FILDEX,MAXFIL,GOGDO,EXTR,INTFIL,RENTLIB;
LABEL ENDER,LAB;
EXTERNAL INTEGER RPGSW;
DEFINE MAXCOMP="60", EXTRACT="1", DOITBIT="4", HEADBIT="2";
DEFINE GOGBIT="8";
STRING ARRAY ORDER,FILES[1:MAXCOMP]; INTEGER ARRAY BITS[1:MAXCOMP];
INTEGER ARRAY SPEC[1:10],BUFR,SYMBLOK[0:'23];
STRING ARRAY FILLST[1:20];
INTEGER ARRAY ENTRS[0:299];
INTEGER ARRAY DOTHIS[1:20];
PROCEDURE LIBHED; COMMENT PROCEDURE TO GROVEL OVER SAIHED.REL;
BEGIN "LIBHED"
INTEGER COUNT,TYPEWD,BLKSIZ,BRK,EOF; DEFINE SRC="BINI",DST="BINO";
INTEGER ARRAY BLOCK[0:17];
PROCEDURE GETBLK;
BEGIN "GETBLK"
IF COUNT=0 THEN BEGIN
TYPEWD ← WORDIN(SRC);
COUNT ← TYPEWD LAND '777777;
TYPEWD ← TYPEWD LSH -18
END;
WORDIN(SRC);
ARRYIN(SRC,BLOCK[0],BLKSIZ ← COUNT MIN 18);
COUNT ← COUNT - BLKSIZ
END "GETBLK";
PROCEDURE PUTBLK(INTEGER TYP, VAL1, VAL2);
BEGIN "PUTBLK"
INTEGER CT;
WORDOUT(DST,TYP LSH 18 + (CT←CASE TYP OF (0,0,2,0,1,1,2)));
WORDOUT(DST,IF TYP=5 THEN '2 LSH 33 ELSE 0);
WORDOUT(DST,VAL1);
IF CT=2 THEN WORDOUT(DST,VAL2);
END "PUTBLK";
IF ¬DOLIB THEN RETURN;
OUTSTR("COPYING (SPECIALLY) SAIHED.REL
");
LOOKUP(SRC,"SAIHED.REL",COUNT);
COUNT←0;
DO GETBLK UNTIL TYPEWD=2;
DO BEGIN
INTEGER B,C;
C←BLOCK[0];
IF (LDB(POINT(6,C,5)) LAND '74) = '44 THEN BEGIN
PUTBLK(4,B←C LAND '37777777777,0);
PUTBLK(6,B,0);
PUTBLK(2,C,BLOCK[1]);
PUTBLK(5,0,0);
END;
GETBLK
END UNTIL TYPEWD=5;
COMMENT AS FUDGE2 DOES NOT COPY THE LAST ELEMENT WE MUST PROVIDE A DUMMY;
PUTBLK(0,0,0);
CLOSE(SRC);
END "LIBHED";
PROCEDURE LIBMAK (STRING F);
BEGIN STRING FILN; INTEGER ETWAS;
BEOF←0; ENTPNT←ETWAS←0;
IF DELETING ∧¬EQU(F,"SAILEP")∧¬EQU(F,"SAIREM") THEN BEGIN "DEL FAIL"
LOOKUP(BINI,F&".FAI",I);
RENAME (BINI,"",0,I);
OUTSTR((IF I THEN "RENAME DIFFICULTY WITH " ELSE NULL)&
F&(IF I THEN ".FAI " ELSE ".FAI DELETED "));
CLOSE (BINI);
ETWAS←TRUE;
END "DEL FAIL";
FILN←F&".REL";
IF EQU(F,"SAIHED") THEN
LIBHED
ELSE IF DOLIB THEN BEGIN "COP FIL"
LOOKUP (BINI,FILN,I);
IF ¬I THEN OUTSTR( "COPYING "&FILN);
ETWAS←TRUE;
SYMBLOK[1]←SYMCNT←0;
IF ¬I THEN WHILE ¬BEOF DO BEGIN "COP BLK"
DEFINE WORD="BUFR[0]";
DO WORD ← WORDIN(BINI) UNTIL BEOF∨WORD≠0;
TYPP←WORD LAND '77000000;
CCOUT ← WORD LAND '777 ;
ARRYIN (BINI,BUFR[1],CCOUT+1);
IF TYPP='4000000 THEN BEGIN "ENTRY BLOCK"
ARRBLT(ENTRS[ENTPNT],BUFR[2],CCOUT);
ENTPNT←ENTPNT+CCOUT;
END "ENTRY BLOCK" ELSE
BEGIN "NOT ENTRY"
IF ENTPNT THEN BEGIN "WRITE ENTRY"
WORDOUT(BINO,'4000000+ENTPNT);
FOR I←0 STEP 18 UNTIL ENTPNT-1 DO BEGIN "WR ECH"
WORDOUT(BINO,0);
ARRYOUT(BINO,ENTRS[I],18 MIN (ENTPNT-I));
END "WR ECH"
END "WRITE ENTRY";
ENTPNT←0;
IF TYPP = '5000000 AND SYMCNT THEN BEGIN "END BLOCK"
COMMENT THIS IS THE END BLOCK -- FORCE OUT SYMBOLS.;
SYMBLOK[0] ← '2000000 +SYMCNT ;
ARRYOUT (BINO,SYMBLOK[0],SYMCNT+2);
END "END BLOCK";
IF TYPP ≠'2000000 THEN BEGIN "NOT SYMBOLS"
COMMENT COPY THE BLOCK TO THE OUTPUT FILE;
ARRYOUT (BINO,BUFR[0],CCOUT+2);
END "NOT SYMBOLS" ELSE
COMMENT THESE ARE SYMBOLS. COPY THEM IF SYMBOLS
ARE REQUESTED. OTHERWISE,
IGNORE UNLESS INTERNAL OR EXTERNAL.;
FOR I←2 STEP 2 UNTIL CCOUT+1 DO
IF LDB(POINT(1,BUFR[I],2))≠1 THEN
BEGIN "SYMS"
SYMCNT ← SYMCNT +2;
SYMBLOK[SYMCNT]←BUFR[I];
SYMBLOK[SYMCNT+1]←BUFR[I+1];
SYMBLOK[1]←SYMBLOK[1] LOR (((BUFR[1]
ROT (2*I)) LAND '17 ) ROT (-2*SYMCNT));
COMMENT LAST LINE WAS UPDATING RELOCATION BITS.;
IF SYMCNT ='22 THEN BEGIN
SYMBLOK[0] ← '2000022 ;
ARRYOUT (BINO,SYMBLOK[0],'24);
SYMCNT←SYMBLOK[1]←0;
END;
END "SYMS";
IF TYPP ='5000000 THEN DONE
END "NOT ENTRY" END "COP BLK" END "COP FIL";
IF DELETING THEN BEGIN "DEL FIL"
CLOSE (BINI);
LOOKUP (BINI,FILN,I);
RENAME (BINI,"",0,I); ETWAS←TRUE;
OUTSTR((IF I THEN " RENAME FAILURE FOR " ELSE " ")&
FILN & (IF I THEN NULL ELSE " DELETED"));
END "DEL FIL";
IF ETWAS THEN TYPE NULL EOM;
END;
BOOLEAN PROCEDURE YESNO(STRING S);
BEGIN
OUTSTR(S&"?");
RETURN(IF (YV←INCHWL)="N" THEN FALSE ELSE YV)
END "YESNO";
BOOLEAN PROCEDURE SUBEQU(STRING S1,S2);
RETURN(EQU(S1,S2[1 FOR LENGTH(S1)]));
STRING PROCEDURE COMPRESS(STRING L,M);
BEGIN "COMPRESS"
IF DSCRING∨NOTINCOM∨M=";"∨¬LENGTH(M)
∨SUBEQU("COMPIL",M) THEN RETURN(NULL)
ELSE RETURN(L&CRLF)
END "COMPRESS";
PROCEDURE GETLINE;
BEGIN "GETLINE"
LINE1←LINE←INPUT(DSKI,TOCRLF);
TS←SCAN(LINE1,OVERDEL,I);
IF ¬DSCRING∧SUBEQU("DSCR",LINE1) THEN DSCRING←TRUE;
IF SUBEQU("COMMENT",LINE1)∨
SUBEQU("Comment",LINE1)∨
SUBEQU("comment",LINE1) THEN
BEGIN
TS←SCAN(LINE1←LINE1[8 TO ∞],OVERDEL,I);
DELIM←I; SETBREAK(COMDEL,DELIM,NULL,"IN");
I←LOP(LINE1);
I←0; TS←SCAN(LINE1,COMDEL,BREAK); IF BREAK≠DELIM THEN
DO LINE1←INPUT(DSKI,COMDEL) UNTIL BREAK=DELIM;
LINE1←NULL
END;
OUT(DSKO,COMPRESS(LINE,LINE1));
IF DSCRING∧(LINE1="⊗"∨LINE1=";") THEN DSCRING←FALSE;
END "GETLINE";
BOOLEAN PROCEDURE FIND(STRING S);
BEGIN "FIND"
FOR COMNO←1 STEP 1 UNTIL MAXTHS DO
IF EQU(S,ORDER[COMNO]) THEN RETURN(TRUE);
RETURN(FALSE)
END "FIND";
PROCEDURE MARKIT(INTEGER C);
BEGIN INTEGER I;
FOR I←1 STEP 1 UNTIL MAXFIL DO
IF EQU(FILES[C],FILLST[I]) THEN BEGIN
DOTHIS[I]←TRUE; DONE
END;
IF BITS[C] LAND EXTRACT THEN FILES[C]←
"HDRFIL(R),"&ORDER[C]
END "MARKIT";
COMMENT MAIN EXECUTION STARTS HERE;
OPEN(DSKI,"DSK",1,2,0,400,BREAK,EOF);
OPEN(DSKO,"DSK",1,0,2,00,W,W);
OPEN(BINI,"DSK",'10,4,0,400,BREAK,BEOF);
OPEN(BINO,"DSK",'10,0,4,00,W,W);
OPEN(COMO,"DSK",1,0,2,00,W,W);
BREAKSET(1,"⊗"&'15,"I");
BREAKSET(1,'12,"O");
BREAKSET(1,NULL,"N");
BREAKSET(2,"→,"&'15,"I");
SETBREAK(TOCRLF,'12,'15&'14,"IN");
SETBREAK(OVERDEL," ",NULL,"XNR");
EACHASK←WILLTELL←GOGDO←RENTLIB←FALSE;
DELETING←DOLIB←DOHEAD←DOEXTR←DOFAIL←INTFIL←TRUE;
IF ¬YESNO("STANDARD") THEN BEGIN "ASK"
STRING ANSWER; INTEGER FROMPASS1;
OUTSTR("
TYPE THE NUMBERS OF THOSE PARAMETERS YOU WISH TO AFFECT:
INDEX DESCRIPTION
");
OUTSTR(IF ¬RPGSW THEN "
1 PASS 2 NOW
2 DON'T CHAIN TO FAIL
3 DON'T CREATE INTERMEDIATE FILES
4 MAKE RE-ENTRANT LIBRARY
5 SELECT ENTRIES FROM PROMPT-LIST
6 SPECIFY ENTRIES EXPLICITLY
7 DON'T DELETE INTERMEDIATE FILES (PASS 2)
8 DON'T MAKE A LIBRARY (PASS 2)
" ELSE "
1 DON'T DELETE INTERMEDIATE FILES
2 DON'T MAKE A LIBRARY
3 MAKE A RE-ENTRANT LIBRARY
4 SELECT ENTRIES FROM PROMPT-LIST
5 SPECIFY ENTRIES EXPLICITLY
");
OUTSTR("*");
ANSWER←INCHWL;
FROMPASS1←FALSE;
WHILE LENGTH(ANSWER) DO BEGIN
LABEL TOOBIG; INTEGER ANSCODE,I;
ANSCODE←INTSCAN(ANSWER,I); IF ¬ANSCODE THEN DONE;
IF ¬RPGSW THEN CASE ANSCODE MIN 7 OF BEGIN
[1] BEGIN RPGSW←TRUE; FROMPASS1←TRUE END;
[2] DOFAIL←FALSE;
[3] INTFIL←FALSE;
[4] RENTLIB←TRUE;
[5] EACHASK←TRUE;
[6] WILLTELL←TRUE;
[7] GO TO TOOBIG
END ELSE
CASE (IF ¬FROMPASS1 THEN ANSCODE MIN 6 ELSE
(CASE ANSCODE MIN 8 OF (0,0,0,0,3,4,5,1,2))) OF BEGIN
[1] DELETING←FALSE;
[2] DOLIB←FALSE;
[3] RENTLIB←TRUE;
[4] EACHASK←TRUE;
[5] WILLTELL←TRUE;
[6]
TOOBIG:OUTSTR(CVS(ANSCODE)&" TOO BIG -- IGNORED"&('15&'12))
END;
END;
END "ASK";
RLSTR←NULL;
IF RENTLIB THEN BEGIN DOLIB←TRUE; RLSTR←"SAIREN.FAI," END;
W←CALL (W,"PJOB");
COMNAM←IF ¬STANSW THEN "0"&CVS( W % 10 )&CVS( W MOD 10)&"FAI.TMP"
ELSE "QQFAIL.RPG";
I←0;
COMMENT READ IN THE ORDER CODE;
GOGDO←FALSE; COMMENT ON IF COMPIL SPEC WANTS GOGOL;
LOOKUP (DSKI,"ORDER",I);
IF I THEN BEGIN TYPE "CAN'T FIND ORDER" EOM; GO ENDER END;
LINE←READ; COMMENT GET COMMENT LINE;
LINE←READ; COMMENT GET REST OF COMMENT LINE;
MAXTHS←MAXFIL←0;
DOTHIS[1]←FALSE; ARRBLT(DOTHIS[2],DOTHIS[1],19);
WHILE ¬SUBEQU("END",FFFF←READ) DO BEGIN "GSPEC"
STRING GGGG; GGGG←FFFF[1 TO 3]; FFFF←FFFF[5 TO ∞];
EXTR←0;
IF EQU("NAM",GGGG) THEN BEGIN "LIBRARY NAME"
LIBNAM←"LIBSA"&(GGGG←SCAN(FFFF,2,I))&".REL";
HLBNAM←"HLBSA"&GGGG&".REL"
END "LIBRARY NAME" ELSE
IF EQU("ALL",GGGG) THEN
WHILE LENGTH(FFFF) DO BEGIN "PREP HDRFIL"
GGGG←SCAN(FFFF,2,I); IF GGGG="!" THEN
GGGG←GOGFIL←GGGG[2 TO ∞];
FILLST[MAXFIL←MAXFIL+1]←GGGG;
DOTHIS[MAXFIL]←TRUE
END "PREP HDRFIL" ELSE BEGIN "LIB LIST"
IF EQU("HDR",GGGG) THEN BEGIN "STD LIB"
EXTR←IF EQU(FFFF,GOGFIL) THEN EXTRACT+GOGBIT ELSE EXTRACT;
FOR I←1 STEP 1 UNTIL MAXFIL DO IF EQU(FFFF,FILLST[I]) THEN DONE;
IF I>MAXFIL THEN FILLST[MAXFIL←MAXFIL+1]←FFFF
END "STD LIB" ELSE IF EQU("HED",GGGG) THEN EXTR←HEADBIT;
LINE←(READ)[2 TO ∞];
WHILE LENGTH(LINE) DO BEGIN "ONE LIB"
ORDER[MAXTHS←MAXTHS+1]←"SAI"&SCAN(LINE,2,J);
BITS[MAXTHS]←EXTR;
FILES[MAXTHS]←FFFF
END "ONE LIB"
END "LIB LIST"
END "GSPEC";
CLOSE(DSKI);
IF ¬WILLTELL THEN BEGIN "GET ORDER"
INTEGER K,KK,J; K←0;
IF EACHASK THEN TYPE "TYPE `Y', `N', OR `DONE'" EOM;
FOR I←1 STEP 1 UNTIL MAXTHS DO BEGIN
TS←ORDER[I];
IF ¬EACHASK∨(KK←YESNO(TS))="Y" THEN BEGIN
IF (J←BITS[I]) LAND GOGBIT THEN GOGDO←TRUE;
BITS[I]←J LOR DOITBIT;
MARKIT(I)
END ELSE IF KK="D" THEN
IF (I←I-1)<0 ∨ K=0 THEN DONE ELSE EACHASK←FALSE;
K←KK
END
END "GET ORDER" ELSE
BEGIN "TAKE ORDER"
TS←NULL;
TYPE "TYPE LIBRARY TITLES, `DONE' WHEN DONE" EOM;
NEEDNEXT WHILE ¬EQU("DONE",TS) DO BEGIN
OUTSTR("*");
TS←INCHWL; NEXT;
IF SUBEQU("SAI",TS)∧LENGTH(TS)=6∧FIND(TS) THEN BEGIN
IF (J←BITS[COMNO]) LAND GOGBIT THEN GOGDO←TRUE;
BITS[COMNO]←J LOR DOITBIT;
MARKIT(COMNO)
END ELSE
TYPE TS&" INVALID -- TRY AGAIN " EOM;
END;
END "TAKE ORDER";
IF RPGSW THEN BEGIN "SECOND PASS -- PROCESS LIBRARY"
IF DELETING THEN BEGIN
LOOKUP(BINI,"HDRFIL",I);
RENAME (BINI,"",0,I);
IF I THEN TYPE "RENAME DIFFICULTY WITH HDRFIL" EOM
ELSE TYPE "HDRFIL DELETED" EOM;
CLOSE (BINI);
IF RENTLIB THEN BEGIN
LOOKUP(BINI,"SAIREN.FAI",I);
RENAME(BINI,"",0,I);
IF I THEN TYPE "RENAME DIFFICULTY WITH SAIREN" EOM
ELSE TYPE "SAIREN.FAI DELETED" EOM;
CLOSE (BINI)
END
END;
I←0;
IF DOLIB THEN
ENTER (BINO,IF RENTLIB THEN HLBNAM ELSE LIBNAM,I);
IF I THEN BEGIN TYPE "CAN'T ENTER "&LIBNAM&".REL" EOM; GO ENDER END;
FOR COMNO←1 STEP 1 UNTIL MAXTHS DO IF BITS[COMNO] LAND DOITBIT THEN
LIBMAK (ORDER[COMNO]);
CLOSE (BINO); COMMENT THIS IS THE LIBRARY;
IF DOLIB THEN BEGIN TYPE "TRY OUT YOUR NEW LIBRARY!" EOM END
ELSE BEGIN TYPE "READY FOR WHATEVER" EOM END;
END ELSE BEGIN "FIRST PASS"
INTEGER PTYSW;
ENTER (COMO,COMNAM,I);
DOHEAD←DOEXTR←FALSE;
IF I THEN TYPE "CANNOT ENTER COMMAND FILE" EOM;
FOR COMNO←1 STEP 1 UNTIL MAXTHS DO
IF BITS[COMNO] LAND DOITBIT THEN BEGIN
STRING SRCFIL;
IF BITS[COMNO] LAND EXTRACT THEN DOEXTR←TRUE;
IF BITS[COMNO] LAND HEADBIT THEN DOHEAD←TRUE;
OUT(COMO,ORDER[COMNO]&"←"&RLSTR&FILES[COMNO]&CRLF);
TYPE ORDER[COMNO]&" WILL BE ASSEMBLED" EOM
END;
OUT(COMO,"DSK:SCISS!"&CRLF);
CLOSE(COMO); CLOSE(DSKO);
IF RENTLIB THEN BEGIN
ENTER(DSKO,"SAIREN.FAI",I); IF I THEN
USERERR(0,0,"TROUBLE WITH SAIREN");
OUT(DSKO,"↓RENSW←←1"&CRLF&CRLF);
CLOSE(DSKO)
END;
IF DOHEAD∧INTFIL THEN BEGIN
ENTER(DSKO,"SAIHED.FAI",I); IF I THEN
USERERR(0,0,"TROUBLE WITH SAIHED");
WRITE CRLF&"↓HEDSYM←←1" EOM;
CLOSE (DSKO);
END;
IF INTFIL∧DOEXTR THEN BEGIN "CR INT FIL"
NOTINCOM←FALSE; ENTER(DSKO,"HDRFIL",I);
IF I THEN USERERR(0,0,"TROUBLE WITH HDRFIL");
WRITE "↓ALWAYS←←0" EOM;
CT←0; PTYSW←0; FILDEX←0;
WHILE TRUE DO BEGIN "DO FILE"
LABEL D;
PROCEDURE OPNFIL;
WHILE (FILDEX←FILDEX+1)≤MAXFIL DO IF DOTHIS[FILDEX] THEN BEGIN
FILE←FILLST[FILDEX];
CLOSE(DSKI);
DSCRING←FALSE;
OUTSTR("LOOKING AT "&FILE&CRLF);
LOOKUP(DSKI,FILE,I); IF I THEN USERERR(0,0,"CAN'T FIND "&FILE);
EOF←FALSE;
DONE
END "OPNFIL";
OPNFIL; IF FILDEX>MAXFIL THEN DONE;
DO BEGIN "READ THE LINES"
GETLINE;
IF SUBEQU("COMPIL",LINE) THEN BEGIN "IS A COMPILE"
IF CT=MAXTHS+1∨¬PTYSW∧CT=MAXTHS THEN DONE;
IF EQU(FILE,GOGFIL)∧¬GOGDO THEN
BEGIN
OUTSTR("ABANDONING "&FILE&" AFTER HDRFIL"&CRLF);
OPNFIL;IF FILDEX>MAXFIL THEN GO D
END;
IF FIND(TS←"SAI"&LINE[8 FOR 3])∧
BITS[COMNO] LAND (DOITBIT+EXTRACT)=DOITBIT+EXTRACT THEN
BEGIN "WANT THIS ONE"
NOTINCOM←FALSE; CLOSE(DSKO);
CT←CT+1;
ENTER(DSKO,TS&".FAI",I);
IF I THEN USERERR(0,0,"TROUBLE WITH SAI"&TS);
TYPE TS&" FOUND" EOM;
IF EQU(TS,"PTY") THEN PTYSW←TRUE;
COMMNT←DSCRING←FALSE;
WRITE LINE EOM
END "WANT THIS ONE"
ELSE NOTINCOM←TRUE
END "IS A COMPILE"
ELSE IF ¬ NOTINCOM ∧ SUBEQU("ENDCOM",LINE1)
THEN BEGIN "THERE" NOTINCOM←TRUE END "THERE";
END "READ THE LINES" UNTIL EOF;
IF MAXTHS=CT∧¬PTYSW ∨ CT=MAXTHS+1 THEN DONE;
IF FALSE THEN D: DONE;
END "DO FILE";
END "CR INT FIL";
CLOSE(DSKO);
COMMENT NOW CHAIN TO FAIL, ONE WAY OR ANOTHER;
SPEC[1]←CVSIX("SYS");
SPEC[2]←CVFIL(IF STANSW THEN "FAIL.DMP" ELSE "FAIL.SAV",SPEC[3],SPEC[5]);
SPEC[4]←IF STANSW THEN 1 ELSE 0;
SPEC[6]←0;
IF DOFAIL THEN CALL(
(IF STANSW THEN 0 ELSE '1000000)+POINT(0,SPEC[1],35),
IF STANSW THEN "SWAP" ELSE "RUN" );
END "FIRST PASS";
ENDER:
END "SCISS";